home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / primops / predicates.t < prev    next >
Encoding:
Text File  |  1989-06-30  |  2.7 KB  |  63 lines
  1. (herald predicates
  2.   (env (*value orbit-env 'base-early-binding-env) primops arith locations low))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;; Really basic type predicates, not primitive to the compiler.
  28.  
  29. (define-constant (null? x)
  30.   (eq? x '()))
  31.  
  32. (define-constant (atom? x)
  33.   (if (pair? x) '#f '#t))
  34.  
  35. (define-constant (pair? x)
  36.   (and (list? x)
  37.        (if (null? x) '#f '#t)))
  38.  
  39. (define-local-syntax (define-extend-predicate type . header-type)
  40.   (let ((header-type (if (atom? header-type) type (car header-type))))
  41.     `(define-constant (,(concatenate-symbol type '?) x)
  42.        (and (extend? x)
  43.             (,(concatenate-symbol header-type '-header?) (extend-header x))))))
  44.  
  45. (define-extend-predicate symbol)
  46. (define-extend-predicate vector general-vector)
  47. (define-extend-predicate bytev)
  48. (define-extend-predicate text)
  49. (define-extend-predicate string)
  50. (define-extend-predicate foreign)
  51. (define-extend-predicate template)
  52. (define-extend-predicate vcell)
  53. (define-extend-predicate unit)
  54. (define-extend-predicate bignum)
  55. (define-extend-predicate weak-set)
  56. (define-extend-predicate weak-alist)
  57. (define-extend-predicate weak-table)
  58. (define-extend-predicate weak-cell)
  59. (define-extend-predicate interrupt-frame)
  60. (define-extend-predicate fault-frame)
  61. (define-extend-predicate double-float)
  62.  
  63.